home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / wgsave11.zip / SCRNSAV3.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-13  |  14KB  |  366 lines
  1. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  2. {$M 8192,0,655360}
  3.  
  4. {File : SCRNSAV3.PAS, Vs. 1.1, for TP 7.0.
  5.  
  6.  Test of screen saver.
  7.  This is only a simple example, don't expect too much.
  8.  Look for all lines with +++ comment.
  9.  
  10.  The Init, GetEvent, HandleEvent and Idle method of TApplication
  11.  need changes.
  12.  
  13.  This program does not disable TV GetEvent while in screen saver mode,
  14.  but see SCRNSAV1.PAS. It also works if modal dialogs are pending.
  15.  In some cases people might want to eat away key strokes which revoked
  16.  the program from screen saver mode. Do this in GetEvent.
  17.  
  18.  Problem:  If a subview of TApplication has its own GetEvent then the
  19.            screen saver might not know when to stop!! This demo
  20.            shows how to cope with such a situation.
  21.  
  22.  If the mechanism to invoke the screen server is ok for you, then just
  23.  put your favorite flashy wonderful screen saver into the Idle method.
  24.  
  25.  Warning: There is a call to Randomize at invocation of the screen
  26.           saver. This might interfere with other parts of your program.
  27.           Take care of checking boolean var ScreenSaverMode in
  28.           your Idle routine (see below).
  29.  
  30.  Hacked on 30-JUN-93 by Wolfgang Gross, gross@aecds.exchi.uni-heidelberg.de
  31.  Comments by Rutger van de GeVEL, rutger@kub.nl.
  32.  
  33.  Changed: 13-JUL-93   bugs, minor improvements
  34.  
  35.  }
  36.  
  37.  
  38. program TestScreenSaver;
  39.   uses CRT,DOS,Objects,memory,Drivers,Views,Menus,Dialogs,App,gadgets;
  40.  
  41.   const
  42.     cmAboutDialog = 101;
  43.     cmTestDialog  = 102;
  44.     cmDummy       = 110;
  45.  
  46.     {change these constants as convenient                            +++}
  47.     cmStartScrnSaver = 200;                                         {+++}
  48.     cmStopScrnSaver  = 201;                                         {+++}
  49.     {your favorite text here}
  50.     ScrnSaverText : String = 'Screen saver test lurking ...' ;      {+++}
  51.     GracePeriod : longint = 5000; {ask DOS time after graceperiod}  {+++}
  52.     {all time values in centiseconds                                 +++}
  53.     {Invoke screen saver after program is idle for ScrnSaverDelay centisecs}
  54.     ScrnSaverDelay  : longint = 500;                                {+++}
  55.     ScrnSaverPeriod : longint = 500;                                {+++}
  56.  
  57.   type
  58.  
  59.     {sample TDialog object to show how the getevent mechanism takes care
  60.      of the screen saver activity. This works also in a different unit.}
  61.     PMyDialog = ^TMyDialog;
  62.     TMyDialog = object(TDialog)
  63.       StartTime : longint;
  64.       CONSTRUCTOR Init ( VAR R : TRect; Atitle: TTitleStr);
  65.       procedure getevent(VAR Event : TEvent ); virtual;
  66.       procedure handleevent(VAR Event : TEvent ); virtual;
  67.       END;
  68.  
  69.     TMyApp = object(TApplication)
  70.       ScrnSaverKickTime,                                            {+++}
  71.       ScrnSaverLastTime : longint; {centiseconds}                   {+++}
  72.       ScrnSaverMode : boolean;                                      {+++}
  73.       GraceCounter : word; {ask DOS time only if > GracePeriod}     {+++}
  74.  
  75.       Heap: PHeapView; Clock : PClockView;
  76.       constructor init;
  77.       procedure getevent( VAR event : TEvent ); virtual;
  78.       procedure HandleEvent(var Event: TEvent); virtual;
  79.       procedure InitMenuBar; virtual;
  80.       procedure InitStatusLine; virtual;
  81.       procedure AboutDialog;
  82.       procedure TestDialog;
  83.       procedure Idle;virtual;
  84.     end;
  85.  
  86.  
  87. FUNCTION Time:longint;                     {+++ we need this function +++}
  88.   {Return real day time in centiseconds. One might get in trouble with
  89.    measurements spanning midnight. Smallest reliable interval: 55 msec}
  90.   VAR Hour,Minute,Second,Sec100: WORD;                               {+++}
  91.   BEGIN                                                              {+++}
  92.     GetTime(Hour,Minute,Second,Sec100);                              {+++}
  93.     Time:=longint(Sec100)+100*(longint(Second)                       {+++}
  94.           +60*(longint(Minute)+60*longint(hour)));                   {+++}
  95.   END;                                                               {+++}
  96.  
  97.  
  98.     {----------------------------------------------------------}
  99.  
  100. CONSTRUCTOR TMyDialog.Init ( VAR R : TRect; Atitle: TTitleStr);
  101.   BEGIN
  102.     inherited Init ( R, Atitle );
  103.     StartTime := time;
  104.   END;
  105.  
  106. PROCEDURE TMyDialog.GetEvent(VAR Event : TEvent );
  107.   VAR SEvent : TEvent;
  108.   BEGIN
  109.     IF (Time-StartTime)>2000 THEN
  110.       BEGIN
  111.         {Stop screen saver. This method works also if TMyDialog is
  112.          defined in a different unit which uses APP. }
  113.         SEvent.What := evcommand;                                    {+++}
  114.         SEvent.command := cmStopScrnSaver;                           {+++}
  115.         Application^.HandleEvent(SEvent);                            {+++}
  116.  
  117.         StartTime := Time;
  118.         Event.What := evCommand;
  119.         Event.command := cmDummy;
  120.         Exit; {We must not call the inherited GetEvent}
  121.       END;
  122.  
  123.     inherited GetEvent(Event);
  124.   END;
  125.  
  126. PROCEDURE TMyDialog.HandleEvent(VAR Event : TEvent );
  127.   BEGIN
  128.     inherited HandleEvent(Event);
  129.  
  130.     IF (Event.What=evCommand) AND (Event.command=cmDummy) THEN
  131.       ClearEvent(Event);
  132.   END;
  133.  
  134.   {------------------------------------------------------------------}
  135.  
  136. CONSTRUCTOR TMyApp.Init;
  137.   VAR R : TRect;
  138.   BEGIN
  139.  
  140.     TApplication.Init;
  141.  
  142.     ScrnSaverKickTime := 0;                                          {+++}
  143.     ScrnSaverLastTime := 0;                                          {+++}
  144.     ScrnSaverMode := false;                                          {+++}
  145.     GraceCounter :=0;                                                {+++}
  146.  
  147.     GetExtent(R);
  148.     R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  149.     Clock := New(PClockView, Init(R));
  150.     Insert(Clock);
  151.  
  152.     GetExtent(R);
  153.     Dec(R.B.X);
  154.     R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  155.     Heap := New(PHeapView, Init(R));
  156.     Insert(Heap);
  157.  
  158.   END; {PROC TMyApp.Init}
  159.  
  160.  
  161.   procedure TMyApp.GetEvent ( VAR Event : TEvent );
  162.     VAR p : pointer; SEvent : TEvent;
  163.     BEGIN
  164.       {BEFORE: Your events before TV, eg. COM input. Don't call the
  165.                inherited GetEvent in this case but proceed directly
  166.                to the AFTER: line}
  167.       inherited GetEvent(Event);
  168.       {AFTER:  Your events after TV}
  169.  
  170.       {We must call HandleEvent explicitly since a pending modal dialog
  171.        will otherwise eat the cmStart/StopScrnSaver event. We don't use
  172.        methods like StartScrnSaver or StopScrnSaver since this is not
  173.        callable by other units while the virtual HandleEvent can be
  174.        called via Application^.HandleEvent.}
  175.  
  176.       {Reset counter if event pending but do not kill this event      +++}
  177.       IF Event.What<>evNothing THEN                                  {+++}
  178.         BEGIN                                                        {+++}
  179.           GraceCounter := 0; ScrnSaverKickTime := 0;                 {+++}
  180.           IF ScrnSaverMode THEN                                      {+++}
  181.             BEGIN                                                    {+++}
  182.               SEvent.What := evcommand;                              {+++}
  183.               SEvent.command := cmStopScrnSaver;                     {+++}
  184.               HandleEvent(SEvent);                                   {+++}
  185.               Exit;                                                  {+++}
  186.             END;                                                     {+++}
  187.         END;                                                         {+++}
  188.  
  189.       IF NOT ScrnSaverMode THEN                                      {+++}
  190.        IF GraceCounter < GracePeriod    {start calling DOS time after +++}
  191.         THEN Inc(GraceCounter)          {grace period since it's too  +++}
  192.         ELSE                            {time consuming.              +++}
  193.           BEGIN
  194.             IF ScrnSaverKickTime=0 THEN ScrnSaverKickTime := Time;   {+++}
  195.             IF (Abs(Time-ScrnSaverKickTime)>ScrnSaverDelay) THEN     {+++}
  196.               BEGIN                                                  {+++}
  197.                 SEvent.What := evcommand;                            {+++}
  198.                 SEvent.command := cmStartScrnSaver;                  {+++}
  199.                 HandleEvent(SEvent);                                 {+++}
  200.                 Exit;                                                {+++}
  201.              END;                                                    {+++}
  202.           END;                                                       {+++}
  203.  
  204.     END; {PROC TMyApp.GetEvent}
  205.  
  206.  
  207.   procedure TMyApp.HandleEvent(var Event: TEvent);
  208.  
  209.     begin {HandleEvent}
  210.  
  211.       inherited HandleEvent(Event);
  212.  
  213.       if (Event.What = evCommand) then
  214.          begin
  215.            case Event.Command of
  216.             cmAboutDialog :
  217.                AboutDialog;
  218.             cmTestDialog :
  219.                TestDialog;
  220.             cmStartScrnSaver :                                   {+++}
  221.                BEGIN                                             {+++}
  222.                  Randomize;                                      {+++}
  223.                  ScrnSaverLastTime := 0;                         {+++}
  224.                  ScrnSaverMode := true;                          {+++}
  225.                  TextBackGround(Black);                          {+++}
  226.                END;                                              {+++}
  227.             cmStopScrnSaver :                                    {+++}
  228.                IF ScrnSaverMode THEN                             {+++}
  229.                  BEGIN                                           {+++}
  230.                    ScrnSaverMode := false;                       {+++}
  231.                    ScrnSaverKickTime := 0; GraceCounter := 0;    {+++}
  232.                    inherited redraw;                             {+++}
  233.                  END;                                            {+++}
  234.             else
  235.  
  236.                Exit;
  237.            end;
  238.            ClearEvent(Event);
  239.          end
  240.  
  241.     end;  {HandleEvent}
  242.  
  243.  
  244. PROCEDURE TMyApp.Idle;
  245.   BEGIN
  246.     inherited Idle;                       {+++ do this in ScrnSaverMode ???}
  247.  
  248.     IF ScrnSaverMode                                                   {+++}
  249.       THEN                                                             {+++}
  250.         BEGIN                                                          {+++}
  251.           IF (Abs(Time-ScrnSaverLastTime)>ScrnSaverPeriod) THEN        {+++}
  252.             BEGIN                                                      {+++}
  253.               ClrScr;                                                  {+++}
  254.               TextColor(Random(14)+1);                                 {+++}
  255.               Gotoxy ( Random(80-length(ScrnSaverText)), Random(24));  {+++}
  256.               write ( ScrnSaverText ); ScrnSaverLastTime := Time;      {+++}
  257.             END;                                                       {+++}
  258.         END                                                            {+++}
  259.       ELSE                                                             {+++}
  260.         BEGIN                                                          {+++}
  261.           Heap^.Update; Clock^.Update;                                 {+++}
  262.         END;                                                           {+++}
  263.  
  264.   END;{PROC TMyApp.Idle}
  265.  
  266.  
  267.   procedure TMyApp.InitMenuBar;
  268.     VAR R : TRect;
  269.     begin {InitMenuBar}
  270.       GetExtent(R);
  271.       R.B.Y := R.A.Y+1;
  272.       MenuBar := New(PMenuBar, Init(R, NewMenu(
  273.         NewSubMenu('~'#240'~', 1000, NewMenu(
  274.           NewItem('~A~bout', '', kbNoKey, cmAboutDialog, 1001,nil)),
  275.         NewSubMenu('~F~ile', 1100, NewMenu(
  276.           NewItem('~T~estDialog', '', kbF3, cmTestDialog, 1010,
  277.           NewLine(
  278.           NewItem('E~x~it', '', kbAltx, cmquit, 1020,nil)))),
  279.       nil)))));
  280.     end;  {PROC TMyApp.InitMenuBar}
  281.  
  282.  
  283.   procedure TMyApp.InitStatusLine;
  284.     var   R : TRect;
  285.     begin  {InitStatusLine}
  286.       GetExtent(R);
  287.       R.A.Y := R.B.Y - 1;
  288.       StatusLine := New(PStatusLine,Init(R,
  289.         NewStatusDef(0,$FFFF,
  290.           NewStatusKey('',kbF10,cmMenu,
  291.           NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
  292.           NewStatusKey('~F3~ Testbox',kbF3,cmTestDialog,
  293.           nil))),
  294.         nil)
  295.       ));
  296.     end; {PROC TMyApp.InitStatusLine}
  297.  
  298.  
  299.   procedure TMyApp.AboutDialog;
  300.     var  D : PDialog;
  301.          R : TRect;
  302.          Control : PView;
  303.          C : word;
  304.     begin {AboutDialog}
  305.       R.Assign(0, 0, 40, 11);
  306.       D := New(PDialog, Init(R, 'About'));
  307.       with D^ do
  308.         begin
  309.           Options := Options or ofCentered;
  310.  
  311.           R.Grow(-1, -1);
  312.           Dec(R.B.Y, 3);
  313.           Insert(New(PStaticText, Init(R,
  314.           #13 + ^C'Turbo Vision Screen Saver Demo'#13 +
  315.           #13 + ^C'GetEvent in effect.'#13 +
  316.           #13 + ^C'W. Gross 1993'#13 )));
  317.  
  318.           R.Assign(15, 8, 25, 10);
  319.           Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  320.          end;
  321.       if ValidView(D) <> nil then
  322.         begin
  323.           c := Desktop^.ExecView(D);
  324.           Dispose(D, Done);
  325.         end;
  326.     end;  {PROC TMyApp.AboutDialog}
  327.  
  328.   procedure TMyApp.TestDialog;
  329.     var D: PDialog;
  330.         R : TRect;
  331.         c : word;
  332.     begin
  333.       R.Assign(0, 0, 40, 11);
  334.       D := New(PMyDialog, Init(R, 'Test Dialog'));
  335.       with D^ do
  336.         begin
  337.           Options := Options or ofCentered;
  338.  
  339.           R.Grow(-1, -1);
  340.           Dec(R.B.Y, 3);
  341.           Insert(New(PStaticText, Init(R,
  342.           #13 + ^C'Turbo Vision Screen Saver Demo'#13 +
  343.           #13 + ^C'Test dialog creates events after '#13 +
  344.           #13 + ^C'a given time interval.'#13 )));
  345.  
  346.           R.Assign(15, 8, 25, 10);
  347.           Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  348.          end;
  349.       if ValidView(D) <> nil then
  350.         begin
  351.           c := Desktop^.ExecView(D);
  352.           Dispose(D, Done);
  353.         end;
  354.     end;  {PROC TMyApp.TestDialog}
  355.  
  356.  
  357.   var
  358.     MyApp : TMyApp;
  359.  
  360.  
  361. begin {SCRNSAV3}
  362.   MyApp.Init;
  363.   MyApp.Run;
  364.   MyApp.Done;
  365. end.  {SCRNSAV3}
  366.